home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir44 / fourword.zip / FOURWORD.BAS next >
BASIC Source File  |  1992-03-27  |  9KB  |  127 lines
  1. 5 ON ERROR GOTO 750
  2. 7 CLOSE : OPEN "i", #1, "words.dat": CLOSE
  3. 10 KEY OFF: CLS : FOR I = 1 TO 8: PRINT : NEXT I: DIM D$(5000): DIM G$(5000): DIM R$(500): RANDOMIZE TIMER
  4. 20 PRINT SPC(I); "█▀▀▀▀▀▀ █▀▀▀▀▀█ █     █ █▀▀▀▀▀█ █  █  █ █▀▀▀▀▀█ █▀▀▀▀▀█ █▀▀▀▀▄"
  5. 30 PRINT SPC(I); "█       █     █ █     █ █     █ █  █  █ █     █ █     █ █     █"
  6. 40 PRINT SPC(I); "█▄▄▄▄▄▄ █     █ █     █ █▄▄▄▄▄█ █  █  █ █     █ █▄▄▄▄▄█ █     █"
  7. 50 PRINT SPC(I); "█       █     █ █     █ █▀▄     █  █  █ █     █ █▀▄     █     █"
  8. 60 PRINT SPC(I); "█       █     █ █     █ █  ▀▄   █  █  █ █     █ █  ▀▄   █     █"
  9. 70 PRINT SPC(I); "█       █▄▄▄▄▄█ █▄▄▄▄▄█ █    ▀▄ █▄▄█▄▄█ █▄▄▄▄▄█ █    ▀▄ █▄▄▄▄▀"
  10. 80 LOCATE 19, 31: PRINT "By Paul Millunzi": SP = 50
  11. 90 FOR I = 9 TO 71: IF SP <> 1 THEN LOCATE 8, I: PRINT CHR$(176): LOCATE 8, I + 1: PRINT CHR$(177): LOCATE 8, I + 2: PRINT CHR$(219): LOCATE 8, I - 1: PRINT " "
  12. 95 IF INKEY$ = " " THEN SP = 1
  13. 100 FOR J = 1 TO SP: NEXT J: NEXT I: LOCATE 8, I - 1: PRINT "   ": IF SP = 1 THEN 230
  14. 110 FOR I = 8 TO 12: IF SP <> 1 THEN LOCATE I, 73: PRINT CHR$(176): LOCATE I + 1, 73: PRINT CHR$(177): LOCATE I + 2, 73: PRINT CHR$(219): LOCATE I - 1, 73: PRINT " "
  15. 115 IF INKEY$ = " " THEN SP = 1
  16. 120 FOR J = 1 TO SP: NEXT J: NEXT I: IF SP = 1 THEN 230
  17. 130 LOCATE I + 1, 73: PRINT " ": LOCATE I, 73: PRINT " ": LOCATE I - 1, 73: PRINT " "
  18. 140 FOR I = 73 TO 11 STEP -1: IF SP <> 1 THEN LOCATE 15, I: PRINT CHR$(176): LOCATE 15, I - 1: PRINT CHR$(177): LOCATE 15, I - 2: PRINT CHR$(219): LOCATE 15, I + 1: PRINT " "
  19. 145 IF INKEY$ = " " THEN SP = 1
  20. 150 FOR J = 1 TO SP: NEXT J: NEXT I: LOCATE 15, I - 2: PRINT "      ": IF SP = 1 THEN 230
  21. 160 FOR I = 15 TO 11 STEP -1: IF SP <> 1 THEN LOCATE I, 9: PRINT CHR$(176): LOCATE I - 1, 9: PRINT CHR$(177): LOCATE I - 2, 9: PRINT CHR$(219): LOCATE I + 1, 9: PRINT " "
  22. 165 IF INKEY$ = " " THEN SP = 1
  23. 170 FOR J = 1 TO SP: NEXT J: NEXT I: IF SP = 1 THEN 230
  24. 180 LOCATE I - 1, 9: PRINT " ": LOCATE I, 9: PRINT " ": LOCATE I + 1, 9: PRINT " "
  25. 190 GOTO 90
  26. 200 LOCATE CSRLIN - 1, 6: PRINT "                                                              ": LOCATE CSRLIN - 1, 6: PRINT "<- "; MS$;
  27. 210 IF INKEY$ <> " " THEN 210 ELSE LOCATE CSRLIN, 1: PRINT "                                                             "
  28. 220 LOCATE CSRLIN - 1, 1: RETURN
  29. 230 GOTO 630
  30. 240 CLS : G = 0: CLOSE : OPEN "i", #1, "words.dat"
  31. 250 IF EOF(1) = -1 THEN CLOSE : GOTO 270
  32. 260 C = C + 1: INPUT #1, D$(C): GOTO 250
  33. 270 IF BS = 1 THEN CLS : GOTO 280
  34. 272 CLS : X = INT(RND * C) + 1: PRINT D$(X): G = G + 1: G$(G) = D$(X): LW$ = D$(X)
  35. 280 LINE INPUT P$: IF P$ = "" AND LW$ <> "" THEN 490
  36. 285 IF P$ = "" THEN MS$ = "enter any four letter word": GOSUB 200: GOTO 280
  37. 290 X$ = "": FOR I = 1 TO LEN(P$): IF ASC(MID$(P$, I, 1)) = 32 THEN 300
  38. 292 IF ASC(MID$(P$, I, 1)) < 97 THEN X$ = X$ + CHR$(ASC(MID$(P$, I, 1)) + 32)
  39. 295 IF ASC(MID$(P$, I, 1)) > 96 THEN X$ = X$ + CHR$(ASC(MID$(P$, I, 1)))
  40. 300 NEXT I: P$ = X$: LOCATE CSRLIN - 1, 1: PRINT "                                                           ": LOCATE CSRLIN - 1, 1: PRINT P$
  41. 305 CK = 0: FOR I = 1 TO LEN(X$): IF ASC(MID$(X$, I, 1)) < 97 OR ASC(MID$(X$, I, 1)) > 122 THEN CK = 1: LOCATE CSRLIN - 1, I: PRINT "?"
  42. 306 NEXT I: IF CK = 1 THEN MS$ = "word contains symbols": GOSUB 200: GOTO 280
  43. 310 CK = 0: FOR I = 1 TO G: IF G$(I) = P$ THEN CK = 1
  44. 320 NEXT I: IF CK = 1 THEN MS$ = "previously used word": GOSUB 200: GOTO 280
  45. 330 IF LEN(P$) > 4 THEN MS$ = "word too long": GOSUB 200: GOTO 280
  46. 340 IF LEN(P$) < 4 THEN MS$ = "word too short": GOSUB 200: GOTO 280
  47. 345 D = 0: IF BS = 1 THEN 370
  48. 350 D = 0: FOR I = 1 TO 4: IF MID$(P$, I, 1) <> MID$(LW$, I, 1) THEN D = D + 1
  49. 360 NEXT I: IF D <> 1 THEN MS$ = "not valid word": GOSUB 200: GOTO 280
  50. 370 D = 0: FOR I = 1 TO 4: IF MID$(P$, I, 1) = "a" OR MID$(P$, I, 1) = "e" OR MID$(P$, I, 1) = "i" OR MID$(P$, I, 1) = "o" OR MID$(P$, I, 1) = "u" OR MID$(P$, I, 1) = "y" THEN D = 1
  51. 380 NEXT I: IF D = 0 THEN MS$ = "word missing vowels": GOSUB 200: GOTO 280
  52. 390 IF P$ = "fuck" OR P$ = "shit" OR P$ = "hell" OR P$ = "damn" THEN MS$ = "colorful metaphors not allowed": GOSUB 200: GOTO 280
  53. 395 IF BS = 1 THEN BS = 0
  54. 400 CK = 0: FOR I = 1 TO C: IF P$ = D$(I) THEN CK = 1
  55. 410 NEXT I: IF CK = 0 THEN 456
  56. 412 LW$ = P$: X = 0: G = G + 1: G$(G) = P$
  57. 415 FOR I = 1 TO C
  58. 420 CK = 0: FOR J = 1 TO 4: IF MID$(D$(I), J, 1) = MID$(LW$, J, 1) THEN CK = CK + 1
  59. 425 NEXT J
  60. 430 IF CK = 3 THEN 445
  61. 435 NEXT I: IF X = 0 THEN 625
  62. 440 LW$ = R$(INT(RND * X) + 1): PRINT LW$: G = G + 1: G$(G) = LW$: GOTO 280
  63. 445 CK = 0: FOR K = 1 TO G: IF G$(K) = D$(I) THEN CK = 1
  64. 450 NEXT K: IF CK = 1 THEN GOTO 435
  65. 455 X = X + 1: R$(X) = D$(I): GOTO 435
  66. 456 MS$ = "word not in electronic dictionary"
  67. 457 LOCATE CSRLIN - 1, 6: PRINT "                                                              ": LOCATE CSRLIN - 1, 6: PRINT "<- "; MS$;
  68. 460 LOCATE CSRLIN + 1, 6: PRINT "   add word to electronic dictionary (y/n)?"
  69. 465 X$ = INKEY$: IF X$ <> "N" AND X$ <> "n" AND X$ <> "Y" AND X$ <> "y" THEN 465
  70. 470 LOCATE CSRLIN - 2, 6: PRINT "                                                "
  71. 475 PRINT "                                                "
  72. 480 IF X$ = "N" OR X$ = "n" THEN LOCATE CSRLIN - 2, 1: PRINT "                                   ": LOCATE CSRLIN - 1, 1: GOTO 280
  73. 485 CLOSE : OPEN "a", #1, "words.dat": PRINT #1, P$: CLOSE : LOCATE CSRLIN - 1, 1: GOTO 412
  74. 490 LOCATE CSRLIN - 1, 6: PRINT "<- (r)esign, (h)int, (c)omputer, (p)lay"
  75. 495 X$ = INKEY$: IF X$ <> "R" AND X$ <> "r" AND X$ <> "H" AND X$ <> "h" AND X$ <> "C" AND X$ <> "c" AND X$ <> "P" AND X$ <> "p" THEN 495
  76. 497 LOCATE CSRLIN - 1, 1: PRINT "                                                              "
  77. 500 IF X$ = "R" OR X$ = "r" THEN 620
  78. 505 IF X$ = "P" OR X$ = "p" THEN LOCATE CSRLIN - 1, 1: GOTO 280
  79. 520 X = 0: QT$ = ""
  80. 525 FOR I = 1 TO C
  81. 530 CK = 0: FOR J = 1 TO 4: IF MID$(D$(I), J, 1) = MID$(LW$, J, 1) THEN CK = CK + 1
  82. 535 NEXT J
  83. 540 IF CK = 3 THEN 555
  84. 545 NEXT I: IF X = 0 THEN QT$ = "": GOTO 570
  85. 550 QT$ = R$(INT(RND * X) + 1): GOTO 570
  86. 555 CK = 0: FOR K = 1 TO G: IF G$(K) = D$(I) THEN CK = 1
  87. 560 NEXT K: IF CK = 1 THEN 545
  88. 565 X = X + 1: R$(X) = D$(I): GOTO 545
  89. 570 IF X$ = "H" OR X$ = "h" THEN 585
  90. 575 IF QT$ = "" THEN MS$ = "no valid words found": GOSUB 200: GOTO 280
  91. 580 G = G + 1: G$(G) = QT$: LW$ = QT$: X = 0: LOCATE CSRLIN - 1, 1: PRINT LW$: GOTO 415
  92. 585 IF QT$ = "" THEN MS$ = "no valid words found": GOSUB 200: GOTO 280
  93. 590 CK = 0: FOR I = 1 TO 4: IF MID$(QT$, I, 1) <> MID$(LW$, I, 1) THEN CK = I
  94. 595 NEXT I
  95. 600 IF CK = 1 THEN MS$ = "change the 1st letter": GOSUB 200: GOTO 280
  96. 605 IF CK = 2 THEN MS$ = "change the 2nd letter": GOSUB 200: GOTO 280
  97. 610 IF CK = 3 THEN MS$ = "change the 3rd letter": GOSUB 200: GOTO 280
  98. 615 IF CK = 4 THEN MS$ = "change the 4th letter": GOSUB 200: GOTO 280
  99. 620 LOCATE CSRLIN - 1, 1: PRINT "rounds played:"; G: PRINT "human resigns, computer wins": END
  100. 625 PRINT "rounds played:"; G: PRINT "computer resigns, human wins": END
  101. 630 CLS : PRINT SPC(30); "-*- FOURWORD -*-": PRINT
  102. 635 PRINT "     The object of FOURWORD is to create new four letter words by changing one"
  103. 640 PRINT "letter of the previous four letter word. For example, if the computer starts"
  104. 645 PRINT "and uses the word MAKE, you could change the K to a D and use the word MADE."
  105. 650 PRINT "The computer might then change the M to a W and use WADE. Game play continues"
  106. 655 PRINT "in this way, with no word used more than once. When one player's four letter"
  107. 660 PRINT "word vocabulary is extinuished, the other player wins."
  108. 665 PRINT "     If you enter a word that does not exist in the computer's vocabulary,"
  109. 670 PRINT "You will be asked to verify it, and the word will be added to the electonic"
  110. 675 PRINT "dictionary for further play. If on your turn you are stumped, you can press"
  111. 680 PRINT "<enter> on a blank line and the computer will ask (r)esign, (h)int, (c)omputer,"
  112. 685 PRINT "(p)lay. Choosing (r)esign admits your defeat, (h)int will give you advice on"
  113. 690 PRINT "what letter to change to create a new word, (c)omputer allows the computer to"
  114. 695 PRINT "play your turn, and (p)lay resumes play, allowing you to choose the word"
  115. 700 PRINT "yourself."
  116. 705 PRINT "     The computer uses artificial intelligence to choose which word to use if"
  117. 710 PRINT "more than one word is possible, for variety. The computer uses the same amount"
  118. 715 PRINT "of time choosing a word on any given turn. However, as the electonic vocabulary"
  119. 720 PRINT "increases, so does the time taken to choose a word. This small time increase"
  120. 725 PRINT "should not be noticable."
  121. 730 LOCATE 23, 25: PRINT "Do you want to start (y/n)?"
  122. 735 X$ = INKEY$: IF X$ <> "Y" AND X$ <> "y" AND X$ <> "N" AND X$ <> "n" THEN 735
  123. 740 IF X$ = "N" OR X$ = "n" THEN 240
  124. 745 BS = 1: GOTO 240
  125. 750 CLS : CLOSE : PRINT : PRINT "vocabulary file, words.dat, not found": END
  126.  
  127.